home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fworld.F < prev    next >
Text File  |  1991-06-03  |  3KB  |  170 lines
  1. c
  2. c most of the things in this program have been done before but it has
  3. c a certain novelty value.
  4. c
  5.     program fworld
  6.  
  7. #ifdef SGI
  8. #include "fgl.h"
  9. #include "fdevice.h"
  10. #else
  11. #include "fvogl.h"
  12. #include "fvodevice.h"
  13. #endif
  14.     integer *2 val
  15.     integer SPHERE
  16.     real RADIUS, PI
  17.     parameter (RADIUS = 10.0, PI = 3.1415926535, SPHERE = 1)
  18.  
  19.     call winope('fworld', 6)
  20.     call hfont('futura.m', 8)
  21.  
  22.     call unqdev(INPUTC)
  23.     call qdevic(SPACEK)
  24.     call qdevic(QKEY)
  25.     call qdevic(ESCKEY)
  26.  
  27.     call perspe(800, 1.0, 0.001, 50.0)
  28.     call lookat(13.0, 13.0, 8.0, 0.0, 0.0, 0.0, 0)
  29.  
  30.     call color(BLACK)
  31.     call clear
  32.  
  33.     call makesp
  34.  
  35. c
  36. c     draw the main one in cyan
  37. c
  38.     call color(CYAN)
  39.  
  40.     call callob(SPHERE)
  41.  
  42. c
  43. c    draw a smaller one outside the main one in white
  44. c
  45.     call color(WHITE)
  46.  
  47.     call pushma
  48.         call transl(0.0, -1.4 * RADIUS, 1.4 * RADIUS)
  49.         call scale(0.3, 0.3, 0.3)
  50.         call callob(SPHERE)
  51.     call popmat
  52.  
  53. c
  54. c    scale the text
  55. c
  56.     call hboxfi(2.0 * PI * RADIUS, 0.25 * RADIUS, 31)
  57.  
  58. c
  59. c    now write the text in rings around the main sphere
  60. c
  61.  
  62.     call color(GREEN)
  63.     call showroundtext('Around the world in eighty days ')
  64.  
  65.     call color(BLUE)
  66. c
  67. c    note: that software text is rotated here as
  68. c    anything else would be whether you use textang
  69. c    or rotate depends on what you are trying to do.
  70. c    Experience is the best teacher here.
  71. c
  72.     call rotate(900, 'x')
  73.     call showroundtext('Around the world in eighty days ')
  74.  
  75.     call color(RED)
  76.     call rotate(900, 'z')
  77.     call showroundtext('Around the world in eighty days ')
  78.  
  79.     idum = qread(val)
  80.  
  81.     call gexit
  82.  
  83.     end
  84. c
  85. c showroundtext
  86. c
  87. c    draw string str wrapped around a circ in 3d
  88. c
  89.     subroutine showroundtext(str)
  90.     character *(*) str
  91.  
  92.     real RADIUS
  93.     parameter (RADIUS = 10.0)
  94.     integer j
  95.  
  96.     inc = 3600 / float(nchars(str))
  97.  
  98.     j = 1
  99.     do 10 i = 0, 3600, inc
  100.         call pushma
  101. c
  102. c             find the spot on the edge of the sphere
  103. c             by making it (0, 0, 0) in world coordinates
  104. c
  105.             call rotate(i, 'y')
  106.             call transl(0.0, 0.0, RADIUS)
  107.  
  108.             call move(0.0, 0.0, 0.0)
  109.  
  110.             call hdrawc(str(j:j))
  111.             j = j + 1
  112.         call popmat
  113. 10    continue
  114.  
  115.     end
  116.  
  117. c
  118. c makesphere
  119. c
  120. c    create the sphere object
  121. c
  122.     subroutine makesp
  123.     integer SPHERE
  124.     parameter (SPHERE = 1)
  125.     parameter(PI = 3.1415926535)
  126.     parameter(RADIUS = 10.0)
  127.  
  128.     call makeob(SPHERE)
  129.  
  130.     do 10 i = 0, 1800, 200
  131.         call pushma
  132.             call rotate(i, 'y')
  133.             call circ(0.0, 0.0, RADIUS)
  134.         call popmat
  135. 10    continue
  136.     
  137.     call pushma
  138.         call rotate(900, 'x')
  139.         do 20 a = -90.0, 90.0, 20.0
  140.             r = RADIUS * cos(a*PI/180.0)
  141.             z = RADIUS * sin(a*PI/180.0)
  142.             call pushma
  143.                 call transl(0.0, 0.0, -z)
  144.                 call circ(0.0, 0.0, r)
  145.             call popmat    
  146. 20        continue
  147.     call popmat
  148.  
  149.     call closeo
  150.  
  151.     return
  152.     end
  153. c
  154. c nchars
  155. c
  156. c    find the number of characters in the string str
  157. c
  158.     integer function nchars(str)
  159.     character *(*) str
  160.     
  161.     do 10 i = len(str), 1, -1
  162.         if (str(i:i) .ne. ' ') then
  163.             nchars = i
  164.             return
  165.         end if
  166. 10    continue
  167.     nchars = 0
  168.     return
  169.     end
  170.